home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / Bonus / VCLZip / kpdemosd.exe / Streams / StrmTest.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1998-12-03  |  5.6 KB  |  220 lines
  1. unit StrmTest;
  2.  
  3. interface
  4.  
  5. uses
  6. {$IFDEF WIN32}
  7.   Windows, ComCtrls,
  8. {$ELSE}
  9.   WinTypes, WinProcs,
  10. {$ENDIF}
  11.   Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  12.   StdCtrls, VCLUnZip, VCLZip, Menus;
  13.  
  14. type
  15.   TForm1 = class(TForm)
  16.     Zipper: TVCLZip;
  17.     MainMenu1: TMainMenu;
  18.     FileMnu: TMenuItem;
  19.     Open1: TMenuItem;
  20.     Save1: TMenuItem;
  21.     Close1: TMenuItem;
  22.     N1: TMenuItem;
  23.     Exit1: TMenuItem;
  24.     TextMemo: TMemo;
  25.     OpenZip: TMenuItem;
  26.     CloseZip: TMenuItem;
  27.     br1: TMenuItem;
  28.     OpenDialog1: TOpenDialog;
  29.     ClearText: TMenuItem;
  30.     UseMemBuffs: TMenuItem;
  31.     N2: TMenuItem;
  32.     procedure OnOpenClick(Sender: TObject);
  33.     procedure OnSaveClick(Sender: TObject);
  34.     procedure FormCreate(Sender: TObject);
  35.     procedure Close1Click(Sender: TObject);
  36.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  37.     procedure Exit1Click(Sender: TObject);
  38.     procedure FileMnuClick(Sender: TObject);
  39.     procedure OpenZipClick(Sender: TObject);
  40.     procedure CloseZipClick(Sender: TObject);
  41.     procedure ClearTextClick(Sender: TObject);
  42.     procedure UseMemBuffsClick(Sender: TObject);
  43.   private
  44.     { Private declarations }
  45.   public
  46.     { Public declarations }
  47.   end;
  48.  
  49. var
  50.   Form1: TForm1;
  51.   CurrentFile: String;
  52.   zipfile: TFileStream;
  53.   zipfilename: String;
  54.  
  55. implementation
  56.  
  57. uses FileDlg;
  58.  
  59. {$R *.DFM}
  60.  
  61. procedure TForm1.OnOpenClick(Sender: TObject);
  62. var
  63.   TxtStream: TMemoryStream;
  64.   n: Integer;
  65.   Buffer: String;
  66.   BufPtr: PChar;
  67. begin
  68.   FileDialog.FileBox.Clear;
  69.   For n := 0 to Zipper.Count-1 do
  70.      FileDialog.FileBox.Items.Add( Zipper.Fullname[n] );
  71.   FileDialog.SelectedFile.ReadOnly := True;
  72.   FileDialog.ShowModal;
  73.   With FileDialog do
  74.   If (ModalResult = mrOK) and (SelectedFile.Text <> '') then
  75.    begin
  76.      CurrentFile := SelectedFile.Text;
  77.      if (UseMemBuffs.Checked) then
  78.       begin
  79.         n := FileDialog.FileBox.ItemIndex;
  80.         SetLength(Buffer, Zipper.UnCompressedSize[n]);
  81.         BufPtr := @Buffer[1];
  82.         Zipper.UnZipToBuffer(BufPtr, CurrentFile );
  83.         TextMemo.Lines.Text := Buffer;
  84.       end
  85.      Else
  86.       begin
  87.         TxtStream := TMemoryStream.Create;
  88.         n := Zipper.UnZipToStream( TxtStream, CurrentFile );
  89.         If n > 0 then
  90.          begin
  91.            TxtStream.Position := 0;
  92.            TextMemo.Lines.Clear;
  93.            TextMemo.Lines.LoadFromStream( TxtStream );
  94.          end;
  95.         TxtStream.Free;
  96.       end;
  97.      Form1.Caption := CurrentFile;
  98.    end;
  99. end;
  100.  
  101. procedure TForm1.OnSaveClick(Sender: TObject);
  102. var
  103.   TxtStream: TMemoryStream;
  104.   n: Integer;
  105. begin
  106.   If TextMemo.Modified then
  107.   With FileDialog do
  108.    begin
  109.      FileBox.Clear;
  110.      For n := 0 to Zipper.Count-1 do
  111.         FileBox.Items.Add( Zipper.Fullname[n] );
  112.      SelectedFile.ReadOnly := False;
  113.      SelectedFile.Text := CurrentFile;
  114.      ShowModal;
  115.      If ModalResult = mrOK then
  116.       begin
  117.         CurrentFile := SelectedFile.Text;
  118.         if (UseMemBuffs.Checked) then
  119.          begin
  120.            Zipper.ZipFromBuffer(PChar(TextMemo.Lines.Text), Length(TextMemo.Lines.Text), CurrentFile);
  121.          end
  122.         Else
  123.          begin
  124.            TxtStream := TMemoryStream.Create;
  125.            TextMemo.Lines.SaveToStream(TxtStream);
  126.            TxtStream.Position := 0;
  127.            Zipper.ZipFromStream( TxtStream, CurrentFile );
  128.            TxtStream.Free;
  129.          end;
  130.         TextMemo.Modified := False;
  131.         Form1.Caption := CurrentFile;
  132.       end;
  133.    end;
  134. end;
  135.  
  136. procedure TForm1.FormCreate(Sender: TObject);
  137. begin
  138.   Zipper.ArchiveStream := nil;
  139.   Zipper.PackLevel := 9;
  140.   TextMemo.Clear;
  141. end;
  142.  
  143. procedure TForm1.Close1Click(Sender: TObject);
  144. begin
  145.   If TextMemo.Modified then
  146.    begin
  147.      If MessageDlg('Save Modified File?',mtConfirmation,[mbYes,mbNo],0) = mrYes then
  148.         OnSaveClick(Self);
  149.    end;
  150. end;
  151.  
  152. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  153. begin
  154.   CloseZipClick(Self);
  155.   Action := caFree
  156. end;
  157.  
  158. procedure TForm1.Exit1Click(Sender: TObject);
  159. begin
  160.   Close;
  161. end;
  162.  
  163. procedure TForm1.FileMnuClick(Sender: TObject);
  164. begin
  165.   CloseZip.Enabled := Zipper.ArchiveStream <> nil;
  166.   Open1.Enabled := Zipper.ArchiveStream <> nil;
  167.   Save1.Enabled := (Zipper.ArchiveStream <> nil) and (TextMemo.Modified);
  168.   Close1.Enabled := TextMemo.Text <> '';
  169.   ClearText.Enabled := TextMemo.Text <> '';
  170. end;
  171.  
  172. procedure TForm1.OpenZipClick(Sender: TObject);
  173. begin
  174.   If (OpenDialog1.Execute) then
  175.    begin
  176.      If (TextMemo.Modified) and (Zipper.ArchiveStream <> nil) then
  177.         Close1Click(Self);
  178.      zipfilename := OpenDialog1.FileName;
  179.      If FileExists( zipfilename ) then
  180.       begin
  181.         zipfile := TFileStream.Create( zipfilename, fmOpenRead );
  182.         Zipper.ArchiveStream := TMemoryStream.Create;
  183.         Zipper.ArchiveStream.CopyFrom( zipfile, zipfile.Size );
  184.         zipfile.Free;
  185.         zipfile := nil;
  186.         Zipper.ReadZip;
  187.       end
  188.      Else
  189.       begin
  190.         Zipper.ArchiveStream := TMemoryStream.Create;
  191.       end;
  192.    end;
  193. end;
  194.  
  195. procedure TForm1.CloseZipClick(Sender: TObject);
  196. begin
  197.   If Zipper.ArchiveStream = nil then
  198.      exit;
  199.   If TextMemo.Modified then
  200.      Close1Click(Self);
  201.   zipfile := TFileStream.Create( zipfilename, fmCreate );
  202.   Zipper.ArchiveStream.Position := 0;
  203.   zipfile.CopyFrom( Zipper.ArchiveStream, Zipper.ArchiveStream.Size );
  204.   Zipper.ClearZip;
  205.   zipfile.Free;
  206.   zipfile := nil;
  207. end;
  208.  
  209. procedure TForm1.ClearTextClick(Sender: TObject);
  210. begin
  211.   TextMemo.Clear;
  212. end;
  213.  
  214. procedure TForm1.UseMemBuffsClick(Sender: TObject);
  215. begin
  216.   UseMemBuffs.Checked := not UseMemBuffs.Checked;
  217. end;
  218.  
  219. end.
  220.